home *** CD-ROM | disk | FTP | other *** search
/ Developer Helper 1: Phil & Dave's Excellent CD / Excellent CD HFS.raw / Moof / Goodies / HyperCard Goodies / HyperCard Dev. ToolKit / Video.Drivers / Sony1500.p < prev   
Text File  |  1987-08-17  |  7KB  |  284 lines
  1. {$R-}
  2. {$D+}
  3. (*
  4.     Sony 1500 -- a HyperCard user-defined command to drive a laser disc 
  5.     player.  (Also Sony 1000A or Sony 2000)
  6.     ©Apple Computer, Inc. 1987
  7.     All Rights Reserved.
  8.  
  9.     To compile and link this file using Macintosh Programmer's Workshop
  10.     (HyperXCmd.p and XCmdGlue.inc must be accessible).
  11.  
  12.     pascal -w Sony1500.p
  13.     link -m ENTRYPOINT -o HyperCommands -rt XCMD=16 -sn Main=Sony1500 ∂
  14.       Sony1500.p.o "{MPW}"Libraries:interface.o
  15.  
  16.     then use ResEdit to copy the resulting XCMD from HyperCommands
  17.     and paste it into the Home stack, or your own stack.
  18.     (XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000,
  19.      =15 PioneerLVP4200, =16 Sony1500)
  20. *)
  21.  
  22. {$S Sony1500 }     { Segment name must be the same as the command name. }
  23.  
  24. UNIT DummyUnit;
  25.  
  26. INTERFACE
  27.  
  28.    USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
  29.     
  30. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  31.     
  32. IMPLEMENTATION
  33.  
  34. TYPE Str19 = String[19];
  35.      Str31 = String[31];
  36.  
  37. PROCEDURE Sony1500(paramPtr: XCmdPtr);                        FORWARD;
  38.  
  39.    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  40.    { entry point cannot have local procs, but forward routines can }
  41.    BEGIN
  42.      Sony1500(paramPtr);
  43.    END;
  44.  
  45.    PROCEDURE Sony1500(paramPtr: XCmdPtr);
  46.    VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
  47.        tempStr: Str255;
  48.        refNum: INTEGER;
  49.        err: INTEGER;
  50.        params: ARRAY[1..32] OF Str19;
  51.  
  52.      {$I XCmdGlue.inc }
  53.       
  54.      PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
  55.      BEGIN
  56.        paramPtr^.returnValue := PasToZero(errMsg);
  57.        EXIT(Sony1500);
  58.      END;
  59.             
  60.      PROCEDURE OpenSerial;
  61.      VAR handShake: SerShk;
  62.          baudRate: INTEGER;
  63.      BEGIN
  64.        baudRate := 9600;
  65.        { for now, use modem port so we don't mess with AppleTalk }
  66.        err := FSOpen('.AOUT',0,refNum);
  67.        IF err = 0 THEN 
  68.          BEGIN
  69.            WITH handShake DO
  70.              BEGIN
  71.                fXon := 1;
  72.                fCTS := 1;
  73.                xon  := CHR(17);
  74.                xoff := CHR(19);
  75.                errs := 0;
  76.                evts := 0;
  77.                fInx := 0;
  78.              END;
  79.            err := SerHShake(refNum,handShake);
  80.            IF err = 0 THEN 
  81.              err := Control(refNum,13,@baudRate);
  82.          END;
  83.      END;
  84.      
  85.      
  86.      PROCEDURE CloseSerial;
  87.      BEGIN
  88.        err := FSClose(refNum);
  89.      END;
  90.      
  91.      FUNCTION Concat(str1, str2, str3: Str31): Str31;
  92.      VAR result: Str255;
  93.          resultLen: INTEGER;
  94.          charNum: INTEGER;
  95.      BEGIN
  96.        result := '';
  97.        resultLen := 0;
  98.        FOR charNum := 1 TO Length(str1) DO
  99.          BEGIN
  100.            resultLen := resultLen + 1;
  101.            result[resultLen] := str1[charNum];
  102.          END;
  103.        FOR charNum := 1 TO Length(str2) DO
  104.          BEGIN
  105.            resultLen := resultLen + 1;
  106.            result[resultLen] := str2[charNum];
  107.          END;
  108.        FOR charNum := 1 TO Length(str3) DO
  109.          BEGIN
  110.            resultLen := resultLen + 1;
  111.            result[resultLen] := str3[charNum];
  112.          END;
  113.       result[0] := CHR(resultLen);
  114.       Concat := result;
  115.      END;
  116.      
  117.      
  118.      
  119.      PROCEDURE SendCommand(myByte: INTEGER; cmd: Str31);
  120.      VAR count: LongInt;
  121.        temp:    Str31;
  122.      { all commands must have an extra char at end, which we smash with CR }
  123.      BEGIN
  124.        temp[1] := CHAR(myByte);
  125.        temp[0] := CHAR(1);        {length}
  126.        IF length(cmd) > 0 THEN
  127.          BEGIN
  128.           temp := Concat(temp, cmd, '^');
  129.           temp[length(temp)] := CHAR($40);    {enter, the completion char}
  130.          END;
  131.        count := Length(temp);
  132.        err := FSWrite(refNum, count, Pointer(Ord(@temp)+1));
  133.      END;
  134.      
  135.      PROCEDURE GetMessage;     
  136.      VAR paramNum, charNum: INTEGER;
  137.          msgChar: CHAR;
  138.      BEGIN
  139.        { convert params to pascal strings }
  140.        FOR paramNum := 1 TO paramPtr^.paramCount DO
  141.          BEGIN
  142.            tempStr := params[paramNum];
  143.            ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
  144.            { force all chars to lower case }
  145.            FOR charNum := 1 TO Length(tempStr) DO
  146.              BEGIN
  147.                msgChar := tempStr[charNum];
  148.                IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
  149.                  tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
  150.              END;
  151.            params[paramNum] := tempStr;
  152.          END;
  153.      END;
  154.      
  155.        
  156.      FUNCTION Contains(target: Str255): BOOLEAN;
  157.      VAR offset: INTEGER;     
  158.      
  159.        FUNCTION Match(which: INTEGER): BOOLEAN;
  160.        VAR index: INTEGER;
  161.        BEGIN
  162.          Match := TRUE;
  163.          FOR index := 1 TO Length(target) DO
  164.            IF index > Length(params[which]) THEN 
  165.              BEGIN
  166.                Match := FALSE;  { ran off the end }
  167.                EXIT(Match);
  168.              END
  169.            ELSE IF target[index] <> params[which][index] THEN
  170.              BEGIN
  171.                Match := FALSE;  { hit a wrong char }
  172.                EXIT(Match);
  173.              END;
  174.        END;
  175.        
  176.      BEGIN
  177.        Contains := FALSE;
  178.        FOR offset := 1 TO paramPtr^.paramCount DO
  179.          IF Match(offset) THEN
  180.            BEGIN
  181.              Contains := TRUE;
  182.              EXIT(Contains);
  183.            END;
  184.      END;
  185.      
  186.      
  187.      FUNCTION GetInteger: Str255;
  188.      { get an integer as straight ASCII }
  189.      VAR which, digitLoc, charVal: INTEGER;
  190.      BEGIN
  191.        FOR which := 1 TO paramPtr^.paramCount DO
  192.          BEGIN
  193.            charVal := ORD(params[which][1]);
  194.            IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
  195.              BEGIN
  196.                GetInteger := params[which];        {that whole parameter}
  197.                  exit(GetInteger);
  198.              END;
  199.          END;
  200.        GetInteger := '';    { just in case }
  201.      END;
  202.  
  203.  
  204.    BEGIN
  205.      OpenSerial;
  206.      IF err <> 0 THEN 
  207.        BEGIN
  208.          SysBeep(1);
  209.          Fail('Could not open serial port');
  210.        END;
  211.      
  212.      GetMessage;
  213.      
  214.      { set flags }
  215.      reverseFlag := Contains('rev');
  216.      offFlag := Contains('off');
  217.      tillFlag := Contains('till');
  218.      
  219.      IF Contains('stop') THEN SendCommand($3F,'')
  220.      ELSE IF Contains('eject') THEN SendCommand($2A,'')
  221.      ELSE IF Contains('search') THEN SendCommand($43,GetInteger)
  222.      ELSE IF Contains('step') THEN
  223.        BEGIN
  224.          IF NOT reverseFlag THEN SendCommand($2B,'')    {step fwd}
  225.          ELSE SendCommand($2C,'')                        {step rev}
  226.        END
  227.      ELSE IF Contains('play') THEN
  228.        BEGIN
  229.          IF NOT tillFlag THEN
  230.              BEGIN
  231.                 IF NOT reverseFlag THEN SendCommand($3A,'')    {play fwd}
  232.                  ELSE SendCommand($4A,'');                     {play rev}
  233.             END
  234.          ELSE SendCommand($44, Concat(GetInteger,'@','01'))    {play till}
  235.        END
  236.      ELSE IF Contains('slow') THEN
  237.        BEGIN
  238.          IF NOT reverseFlag THEN SendCommand($3C,'')
  239.            ELSE SendCommand($4C,'')
  240.        END
  241.      ELSE IF Contains('fast') THEN
  242.        BEGIN
  243.          IF NOT reverseFlag THEN SendCommand($3B,'')
  244.            ELSE SendCommand($4B,'')
  245.        END
  246.      ELSE IF Contains('scan') THEN
  247.        BEGIN
  248.          IF NOT reverseFlag THEN SendCommand($3E,'')        {scan fwd}
  249.          ELSE SendCommand($4E,'')                        {scan rev}
  250.        END
  251.      ELSE IF Contains('picture') THEN
  252.        BEGIN
  253.          IF NOT offFlag THEN SendCommand($27,'')            {picture on}
  254.          ELSE SendCommand($26,'')                            {picture off}
  255.        END
  256.      ELSE IF Contains('frame') THEN
  257.        BEGIN
  258.          IF NOT offFlag THEN SendCommand($50,'')            {frame on}
  259.          ELSE SendCommand($51,'')                            {frame off}
  260.        END
  261.      ELSE IF Contains('sound') THEN 
  262.        BEGIN
  263.          IF Contains('1') THEN
  264.            IF NOT offFlag THEN SendCommand($46,'')            {sound 1 on}
  265.            ELSE SendCommand($47,'')                            {sound 1 off}
  266.          ELSE IF Contains('2') THEN
  267.            IF NOT offFlag THEN SendCommand($48,'')            {sound 2 on}
  268.            ELSE SendCommand($49,'')                            {sound 2 off}
  269.        END
  270.      ELSE IF Contains('init') THEN SendCommand($62,'')
  271.      ELSE
  272.         BEGIN
  273.           CloseSerial;
  274.           SysBeep(1); 
  275.           Fail('Unknown video command');
  276.         END;
  277.      CloseSerial;
  278.    END;   
  279.  
  280. END.
  281.  
  282.  
  283.  
  284.